home *** CD-ROM | disk | FTP | other *** search
/ Suzy B Software 2 / Suzy B Software CD-ROM 2 (1994).iso / nasa / precess / prec.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-05-02  |  2.7 KB  |  99 lines
  1. program praezession;
  2.  
  3. const
  4.    {$I b:math_con }
  5.  
  6. type
  7.    ZEIT = record
  8.              stunde:0..23;
  9.              minute,sekunde:0..59;
  10.           end;
  11.  
  12.    DATUM = record
  13.               jahr:integer;
  14.               monat:1..12;
  15.               tag:1..31;
  16.            end;
  17.  
  18.    JUL = record
  19.             ganz:long_integer;
  20.             fract:real;
  21.          end;
  22.  
  23. var raa,ran:ZEIT;
  24.     raa1,ran1,dea,den:real;
  25.     jdalt,jdneu:JUL;
  26.     c:char;
  27.  
  28.    {$I b:math_sub }
  29.  
  30. procedure juldat(var julian:JUL; gregorian:DATUM; uhrzeit:ZEIT;
  31.                  flag:boolean);
  32. external;
  33.  
  34. procedure praezession(var ran,den:real; raa,dea:real; equi,dat:JUL);
  35. external;
  36.  
  37. procedure nutation(var ran,den:real; raa,dea:real; dat:JUL);
  38. external;
  39.  
  40. procedure equinox(var jd:JUL);
  41. var date:DATUM;
  42.     lokal:ZEIT;
  43.     c:char;
  44.     flag:boolean;
  45. begin
  46.    write('> Year : '); readln(date.jahr);
  47.    write('> Month: '); readln(date.monat);
  48.    write('> Day  : '); readln(date.tag);
  49.    write('> Greg. calendar (y/n): '); read(c); writeln;
  50.    if c = 'n' then flag := false else flag := true;
  51.    lokal.stunde := 0;
  52.    lokal.minute := 0;
  53.    lokal.sekunde := 0;
  54.    juldat(jd,date,lokal,flag)
  55. end;
  56.  
  57. procedure time(var t:ZEIT; t1:real);
  58. var f:real;
  59. begin
  60.    f := deg(t1) / 15.0;
  61.    t.stunde := trunc(f); f := (f - t.stunde) * 60.0;
  62.    t.minute := trunc(f); f := (f - t.minute) * 60.0;
  63.    t.sekunde := trunc(f);
  64. end;
  65.  
  66. begin
  67.    write(chr(27),'E');
  68.    writeln('< CORRECT COORDINATES AGAINST PRECISION >');
  69.    writeln;
  70.    writeln('  Enter equinox of old coordinates:');
  71.    equinox(jdalt);
  72.    writeln('  Enter old mean coordinates:');
  73.    write('> Right ascension: hour  : '); readln(raa.stunde);
  74.    write('>                  minute: '); readln(raa.minute);
  75.    write('>                  second: '); readln(raa.sekunde);
  76.    write('> Declination            : '); readln(dea);
  77.    raa1 := 15.0 * (raa.stunde + raa.minute / 60.0 + raa.sekunde / 3600.0);
  78.    raa1 := rad(raa1); dea := rad(dea);
  79.    write(chr(27),'E');
  80.    writeln('< CORRECT COORDINATES AGAINST PRECISION >');
  81.    writeln;
  82.    writeln('  Enter equinox of new coordinates:');
  83.    equinox(jdneu); writeln;
  84.    praezession(ran1,den,raa1,dea,jdalt,jdneu);
  85.    time(ran,ran1);
  86.    writeln('  New mean coordinates:');
  87.    writeln('  Right ascension: ',ran.stunde:2,ran.minute:3,ran.sekunde:3);
  88.    writeln('  Declination    : ',deg(den):10:5);
  89.    writeln;
  90.    raa1 := ran1; dea := den;
  91.    nutation(ran1,den,raa1,dea,jdneu);
  92.    time(ran,ran1);
  93.    writeln('  New true coordinates:');
  94.    writeln('  Right ascension: ',ran.stunde:2,ran.minute:3,ran.sekunde:3);
  95.    writeln('  Declination    : ',deg(den):10:5);
  96.    writeln;
  97.    read(c)
  98. end.
  99.